home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / rdblib / rdblib.bas < prev    next >
BASIC Source File  |  1995-05-09  |  14KB  |  377 lines
  1. ' Common Subroutine & Functions Module
  2. ' Provided by:
  3. '    Royce D. Bacon
  4. '    RDB Systems
  5. '    8942 W. Lawrence Ave.
  6. '    Milwaukee, WI  53225
  7. '    Compuserve ID: 70042,1001
  8. '
  9. ' You may use these routines in your own programs and
  10. ' distribute them or the compiled versions of them
  11. ' with your programs.  However, you may not distribute
  12. ' these routines alone for profit.
  13. '
  14. ' Payment for these routines is not required, but will
  15. ' always be appreciated.
  16. '
  17.  
  18.  
  19. Global rb_systemname As String
  20. Global rb_version As String
  21. Global RB_Erraction As Integer
  22. Global Const RB_GRAY = &HC0C0C0
  23. ' Constants, etc. for screen capture/print function
  24. Global Const SW_HIDE = 0
  25. Global Const SW_SHOW = 5
  26. Declare Function ShowWindow Lib "User" (ByVal hwnd As Integer, ByVal nCmdShow As Integer) As Integer
  27.  
  28.  
  29. ' Windows function declarations
  30.  
  31. Declare Function GetModuleUsage Lib "KERNEL" (ByVal InstanceID%) As Integer
  32.  
  33. '******************************************************
  34. '           DLL Declarations                          *
  35. '******************************************************
  36. Type POINTAPI
  37.     X As Integer
  38.     Y As Integer
  39. End Type
  40.  
  41. Declare Function LoadMenu Lib "User" (ByVal hInstance As Integer, ByVal lpString As String) As Integer
  42. Declare Function GetMenu Lib "User" (ByVal hwnd As Integer) As Integer
  43. Declare Function SetMenu Lib "User" (ByVal hwnd As Integer, ByVal hMenu As Integer) As Integer
  44. Declare Function HiliteMenuItem Lib "User" (ByVal hwnd As Integer, ByVal hMenu As Integer, ByVal wIDHiliteItem As Integer, ByVal wHilite As Integer) As Integer
  45. Declare Function GetMenuString Lib "User" (ByVal hMenu As Integer, ByVal wIDItem As Integer, ByVal lpString As String, ByVal nMaxCount As Integer, ByVal wFlag As Integer) As Integer
  46. Declare Function GetMenuState Lib "User" (ByVal hMenu As Integer, ByVal wId As Integer, ByVal wFlags As Integer) As Integer
  47. Declare Sub DrawMenuBar Lib "User" (ByVal hwnd As Integer)
  48. Declare Function GetSystemMenu Lib "User" (ByVal hwnd As Integer, ByVal bRevert As Integer) As Integer
  49. Declare Function GetSubMenu Lib "User" (ByVal hMenu As Integer, ByVal nPos As Integer) As Integer
  50. Declare Function GetMenuItemID Lib "User" (ByVal hMenu As Integer, ByVal nPos As Integer) As Integer
  51. Declare Function GetMenuItemCount Lib "User" (ByVal hMenu As Integer) As Integer
  52. Declare Function TrackPopupMenu Lib "User" (ByVal hMenu As Integer, ByVal wFlags As Integer, ByVal X As Integer, ByVal Y As Integer, ByVal nReserved As Integer, ByVal hwnd As Integer, lpReserved As Any) As Integer
  53. Declare Function InsertMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As Any) As Integer
  54. Declare Function AppendMenu Lib "User" (ByVal hMenu As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpNewItem As Any) As Integer
  55. Declare Function ModifyMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer, ByVal wIDNewItem As Integer, ByVal lpString As Any) As Integer
  56. Declare Function RemoveMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
  57. Declare Function DeleteMenu Lib "User" (ByVal hMenu As Integer, ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
  58.  
  59. Declare Function ExitWindows Lib "User" (ByVal dwReserved As Long, wReturnCode) As Integer
  60. Declare Function GetDeviceCaps Lib "GDI" (ByVal hDC As Integer, ByVal nIndex As Integer) As Integer
  61. Declare Function GetActiveWindow Lib "User" () As Integer
  62. Declare Sub GetCursorPos Lib "User" (lpPoint As POINTAPI)
  63. Declare Function GetSystemMetrics Lib "User" (ByVal nIndex As Integer) As Integer
  64. Declare Function GetFocus Lib "User" () As Integer
  65. Declare Function SetActiveWindow Lib "User" (ByVal hwnd As Integer) As Integer
  66. Declare Function GetModuleHandle Lib "Kernel" (ByVal lpModuleName As String) As Integer
  67. Declare Function GetModuleFileName Lib "Kernel" (ByVal hModule As Integer, ByVal lpFilename As String, ByVal nSize As Integer) As Integer
  68. Declare Function GetFreeSpace Lib "Kernel" (ByVal wFlags As Integer) As Long
  69.  
  70. 'Indices for GetSystemMetrics
  71. Global Const SM_CXSIZE = 30
  72. Global Const SM_CYSIZE = 31
  73.  
  74. 'Indices for GetDeviceCaps
  75. Global Const HORZRES = 8    '  Horizontal width in pixels
  76. Global Const VERTRES = 10   '  Vertical width in pixels
  77.  
  78. 'Menu flags for Add/Check/EnableMenuItem()
  79. Global Const MF_INSERT = &H0
  80. Global Const MF_CHANGE = &H80
  81. Global Const MF_APPEND = &H100
  82. Global Const MF_DELETE = &H200
  83. Global Const MF_REMOVE = &H1000
  84.  
  85. Global Const MF_BYCOMMAND = &H0
  86. Global Const MF_BYPOSITION = &H400
  87.  
  88. Global Const MF_SEPARATOR = &H800
  89.  
  90. Global Const MF_ENABLED = &H0
  91. Global Const MF_GRAYED = &H1
  92. Global Const MF_DISABLED = &H2
  93.  
  94. Global Const MF_UNCHECKED = &H0
  95. Global Const MF_CHECKED = &H8
  96. Global Const MF_USECHECKBITMAPS = &H200
  97.  
  98. Global Const MF_STRING = &H0
  99. Global Const MF_BITMAP = &H4
  100. Global Const MF_OWNERDRAW = &H100
  101.  
  102. Global Const MF_POPUP = &H10
  103. Global Const MF_MENUBARBREAK = &H20
  104. Global Const MF_MENUBREAK = &H40
  105.  
  106. Global Const MF_UNHILITE = &H0
  107. Global Const MF_HILITE = &H80
  108.  
  109. Global Const MF_SYSMENU = &H2000
  110. Global Const MF_HELP = &H4000
  111. Global Const MF_MOUSESELECT = &H8000
  112.  
  113. '  Menu item resource format
  114. Type MENUITEMTEMPLATEHEADER
  115.     versionNumber As Integer
  116.     offset As Integer
  117. End Type
  118.  
  119. Type MENUITEMTEMPLATE
  120.     mtOption As Integer
  121.     mtID As Integer
  122.     mtString As Long
  123. End Type
  124.  
  125. Global Const MF_END = &H80
  126.  
  127. '  System Menu Command Values
  128. Global Const SC_SIZE = &HF000
  129. Global Const SC_MOVE = &HF010
  130. Global Const SC_MINIMIZE = &HF020
  131. Global Const SC_MAXIMIZE = &HF030
  132. Global Const SC_NEXTWINDOW = &HF040
  133. Global Const SC_PREVWINDOW = &HF050
  134. Global Const SC_CLOSE = &HF060
  135. Global Const SC_VSCROLL = &HF070
  136. Global Const SC_HSCROLL = &HF080
  137. Global Const SC_MOUSEMENU = &HF090
  138. Global Const SC_KEYMENU = &HF100
  139. Global Const SC_ARRANGE = &HF110
  140. Global Const SC_RESTORE = &HF120
  141. Global Const SC_TASKLIST = &HF130
  142.  
  143. '******************************************************
  144. '*          OpenFile Modes                            *
  145. '******************************************************
  146. Global Const REPLACEFILE = 0
  147. Global Const READFILE = 1
  148. Global Const APPENDFILE = 2
  149. Global Const RANDOMFILE = 3
  150. Global Const BINARYFILE = 4
  151.  
  152.  
  153. '**************************************************
  154. ' Declares for screen grabber function
  155. '**************************************************
  156. Type lrect
  157.     left As Integer
  158.     top As Integer
  159.  
  160.     right As Integer
  161.     bottom As Integer
  162. End Type
  163. Declare Function GetDesktopWindow Lib "user" () As Integer
  164. Declare Function GetDC Lib "user" (ByVal hwnd%) As Integer
  165.  
  166. ' Note: The following Declare should be on one line:
  167. Declare Function BitBlt Lib "GDI" (ByVal hDestDC%, ByVal X%, ByVal Y%, ByVal nWidth%, ByVal nHeight%, ByVal hSrcDC%, ByVal XSrc%, ByVal YSrc%, ByVal dwRop&) As Integer
  168. Declare Function ReleaseDC Lib "User" (ByVal hwnd As Integer, ByVal hDC As Integer) As Integer
  169.  
  170. Declare Sub GetWindowRect Lib "User" (ByVal hwnd%, lpRect As lrect)
  171. Global TwipsPerPixel As Single
  172.  
  173.  
  174. 'Other API Declarations For Sound
  175. Declare Sub MessageBeep Lib "User" (ByVal wType As Integer)
  176. Declare Sub SndPlaySound Lib "MMSystem.dll" (ByVal WavFile$, ByVal wFlags As Integer)
  177.  
  178. Sub RB_Center (str_to_print As String, line_no, skip_line As Integer)
  179.     ' ============= RB_Center ==============================
  180.     ' Will center a string passed as parameter 1
  181.     ' on printer line passed as parameter 2 or current line if parameter 2 = 0
  182.     ' Will skip to next line if parameter 3 = true
  183.     ' e.g. RB_Center "This String Will Be Centered On Line 3", 3, true
  184.     '
  185.     Dim col_to_print_at As Single
  186.     col_to_print_at = ((printer.ScaleWidth - printer.TextWidth(str_to_print)) / 2) + printer.ScaleLeft
  187.     printer.CurrentX = col_to_print_at
  188.     If line_no <> 0 Then
  189.         printer.CurrentY = line_no
  190.     End If
  191.     If skip_line Then
  192.         printer.Print str_to_print
  193.     Else
  194.         printer.Print str_to_print;
  195.     End If
  196.  
  197. End Sub
  198.  
  199. Function RB_ErrorHandler (pform As Strin